home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / epistat.arc / MHCHIMLT.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1983-08-18  |  3.1 KB  |  61 lines
  1. 1  REM      MANTEL-HAENSZEL MATCHED CHI-SQUARE FOR MULTIPLE CONTROLS
  2. 2  REM             Written by Tracy L. Gustafson, M.D.
  3. 3  REM            Round Rock, Texas. Version 2.0, 1983
  4. 5  DEF SEG=&H40
  5. 6  A=PEEK(&H17): IF NOT(A AND &H20) THEN POKE &H17,(A AND (NOT &H20)) OR &H20
  6. 7  DEF SEG: KEY OFF: SCREEN 0,0: WIDTH 80: COLOR 7,0,1
  7. 10  CLEAR: OPTION BASE 1: DEFINT A-C,N,T,Z: DEFSTR D
  8. 20  CLS: PRINT TAB(8);"KEY";STRING$(58,205);"CLOSE"
  9. 22  PRINT TAB(8);"OPEN MANTEL-HAENSZEL MATCHED CHI-SQUARE FOR MULTIPLE CONTROLS OPEN"
  10. 23  PRINT TAB(8);"SCREEN";STRING$(58,205);"LOAD"
  11. 25  PRINT: AP=CSRLIN: ON ERROR GOTO 330
  12. 30  PRINT "    Enter the name of the DATAFILE you would like to analyze:"
  13. 35  PRINT "     (Press RETURN if you want to enter summary data here.)"
  14. 40  LOCATE AP,65: INPUT "",FILE$: PRINT
  15. 50  IF FILE$<>"" THEN 100
  16. 55  PRINT: PRINT TAB(14);: INPUT "How many matched groups will you enter?   ",NM
  17. 57  PRINT TAB(10);:INPUT "How many controls are matched with each case?   ",AM
  18. 60  PRINT TAB(8);: INPUT "What is the characteristic or factor under study?   ",F$
  19. 62  HX=0: HX2=0: BXT=0
  20. 65  PRINT: PRINT TAB(25);"No. of CASES";TAB(50);"No. of CONTROLS"
  21. 70  PRINT TAB(5);"Group #";TAB(26);"+ ";F$;TAB(53);"+ ";F$:PRINT STRING$(66,"-")
  22. 75  FOR Z=1 TO NM: PRINT TAB(8);Z;TAB(29);
  23. 77  INPUT ;"",AX: IF AX>1 THEN BEEP: PRINT "The number of positive cases per group should be 0 or 1.": GOTO 62 ELSE PRINT TAB(56);
  24. 80  INPUT "",BX: IF BX>AM THEN BEEP: PRINT "The number of positive controls per group should be";AM;"or less.": GOTO 62
  25. 82  CX=AX+BX: HX=HX+CX: HX2=HX2+CX*CX: XBT=XBT+BX
  26. 85  NEXT Z: PRINT STRING$(66,"-"): PRINT: PRINT
  27. 90  GOTO 180
  28. 100  OPEN FILE$ FOR INPUT AS #1: INPUT #1, A,C
  29. 105  DIM D(A,C),CS(A,C),N$(A),X(A),X2(A),T(A),SD(A),MD(A),NS(A)
  30. 110  FOR T=1 TO A: INPUT #1, T(T): NEXT
  31. 115  FOR T=1 TO A: FOR Z=1 TO C: INPUT #1, D(T,Z): NEXT: NEXT
  32. 120  FOR T=1 TO A: FOR Z=1 TO T(T): INPUT #1, CS(T,Z): NEXT: NEXT
  33. 125  FOR T=1 TO A: INPUT #1, N$(T),X(T),X2(T),MD(T),SD(T): NEXT: CLOSE #1
  34. 130  PRINT: PRINT: PRINT TAB(11);: INPUT "How many CONTROLS are there for each CASE?   ",AM: PRINT
  35. 135  PRINT TAB(10);: INPUT;"What is the SAMPLE NUMBER of the CASE group?   ",NS(1): PRINT "  `";N$(NS(1));"'"
  36. 140  PRINT TAB(9);"What are the";AM;"SAMPLE NUMBERS of the CONTROL groups?";
  37. 145  FOR Z=2 TO AM+1: PRINT TAB(64);:INPUT;"",NS(Z): PRINT "  `";N$(NS(Z));"'";: NEXT Z
  38. 150  FOR Z=2 TO AM+1: IF T(NS(1))<>T(NS(Z)) THEN BEEP: PRINT "These samples do not all have the same number of elements----": PRINT TAB(25);"a paired Mantel-Haenszel test cannot be performed.": GOTO 290
  39. 155  NEXT: XBT=0: HX=0: HX2=0
  40. 160  FOR Z=1 TO T(NS(1)): XA=VAL(D(NS(1),Z)): XB=0: IF ABS(XA-0.5)>0.51 THEN 320
  41. 165  FOR T=2 TO AM+1: QX=VAL(D(NS(T),Z)): XB=XB+QX: IF ABS(QX-0.5)>0.51 THEN 320
  42. 167  NEXT
  43. 170  XC=XA+XB: HX=HX+XC: HX2=HX2+XC*XC: XBT=XBT+XB
  44. 175  NEXT: PRINT: PRINT
  45. 180  X=AM*HX-(AM+1)*XBT: X=X*X/((AM+1)*HX-HX2)
  46. 200  PRINT TAB(22);"CHI-SQUARE = ";X: PRINT
  47. 210  IF X>31 THEN P=0: GOTO 270
  48. 220  R=1.77245: S=1: I=1: K=SQR(X/2)*2/(EXP(X/2)*R): AD=3
  49. 240  I=I*X/AD: S=S+I: AD=AD+2: IF I>0 THEN 240
  50. 260  P=1-K*S
  51. 270  PLAY "O3 MB MS T120 L16 D-FA- O4 L8 D- P8 O3 L3 D-": PRINT TAB(10);
  52. 280  COLOR 0,7: PRINT TAB(28);"p = ";: IF P<=0 THEN PRINT "< 10 (-8)"; ELSE PRINT P;
  53. 290  PRINT TAB(60): COLOR 7,0: PRINT: PRINT: PRINT: PRINT TAB(3);
  54. 300  INPUT "Do you want to calculate another Mantel-Haenszel test? (Y or N)  ",A$:IF A$="y" OR A$="Y" THEN 10
  55. 310  END
  56. 320  BEEP: PRINT: PRINT: PRINT "An error in data entry was detected:": PRINT "All records should contain a "1" if factor is present, a "0" if it is absent.": PRINT: GOTO 290
  57. 330  BEEP: PRINT: IF ERL=100 AND ERR=53 THEN PRINT TAB(13); "I cannot find a file by that name on drive "; ELSE 360
  58. 340  IF MID$(FILE$,2,1)=":" THEN DR$=LEFT$(FILE$,2) ELSE DR$="A:"
  59. 350  PRINT DR$: PRINT "Your files are:": FILES DR$+"*.*": RESUME 25
  60. 360  ON ERROR GOTO 0
  61.